home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / simula / books / books.lha / kirkerud / nim.sim < prev    next >
Text File  |  1993-08-16  |  10KB  |  283 lines
  1. % ****************************************************************
  2. % *                                                              *
  3. % *  This is the program constructed in chapter 10 of             *
  4. % *  Object Oriented Programming with Simula by Bj|rn Kirkerud;  *
  5. % *                                                              *
  6. % ****************************************************************
  7.  
  8.  
  9. begin
  10.  
  11.  
  12. class Nim_player(initial_heap_size, max_matches_in_move);
  13.     integer initial_heap_size, max_matches_in_move;
  14.     virtual:
  15.       procedure another_game is  Boolean procedure another_game;;
  16.       procedure move is  integer procedure move(heap_size); integer heap_size;;
  17.       procedure Game_over is  procedure Game_over(victory); Boolean victory;;
  18.         !  By specifying these procedures to be virtual we allow
  19.         !  each type of Nim_player to have special versions of them;
  20.   begin
  21.     !  There are no attributes which all kinds of  Nim_player's share
  22.     !  except  initial_heap_size  and max_matches_in_move
  23.     !  and no imperatives which all Nim_player's share.
  24.     !  The body of a general Nim_player is therefore empty;
  25.   end of Nim_player;
  26.  
  27.  
  28. Nim_player class Human;
  29.     protected human_name, Give_instructions;
  30.   begin
  31.  
  32.     character human_name;  ! character should be changed to text
  33.                            ! when we know how to handle text  variables;
  34.  
  35.     Boolean procedure another_game;
  36.       begin
  37.         outtext("Another game "); outchar(human_name);
  38.         another_game := prompt_for_bool("? ");
  39.       end of another_game;
  40.  
  41.     integer procedure move(heap_size);  integer heap_size;
  42.       begin integer user_move;
  43.         outtext("There are now ");
  44.         outint(heap_size, 0); outtext(" matches in the heap. ");
  45.         user_move := prompt_for_int("What is your move? ");
  46.         while not(1 le user_move and  user_move le
  47.               min(heap_size, max_matches_in_move)) do
  48.           begin
  49.             User_message("Illegal move!");
  50.             outtext("You must take at least 1 but never  more than ");
  51.             outint(max_matches_in_move, 0);  outtext(" matches"); outimage;
  52.             if prompt_for_bool("Perhaps you want  instructions? ")
  53.               then Give_instructions;
  54.             user_move := prompt_for_int("Give a legal move> ");
  55.           end;
  56.         move := user_move;
  57.       end of move;
  58.  
  59.     procedure Game_over(victory); Boolean victory;
  60.       begin
  61.         outtext(if victory then "Congratulations "  else "Sorry ");
  62.         outchar(human_name);
  63.         outtext(if victory then "! You won!"
  64.             else ", you lost.  Better luck(?) next time.");
  65.         outimage; outimage;
  66.       end;
  67.  
  68.     procedure Give_instructions;
  69.       User_message("Sorry, no instructions are available "
  70.                  "in the current implementation.");
  71.  
  72.     !   Initialization:  ;
  73.       user_message("Welcome to the game of Nim!");
  74.       human_name := prompt_for_char("What is your name? ");
  75.       if prompt_for_bool("Do you want instructions? ")
  76.         then Give_instructions;
  77.  
  78.   end of Human;
  79.  
  80.  
  81. Nim_player class Machine;
  82.     protected compute_move, gagged;
  83.     virtual: integer procedure compute_move;
  84.   begin
  85.  
  86.     Boolean procedure another_game;
  87.       another_game := true;
  88.       !   A machine is always ready for another game;
  89.  
  90.     integer procedure move(heap_size);  integer heap_size;
  91.       begin integer my_move;
  92.         my_move := compute_move(heap_size);
  93.         if not gagged then
  94.           begin
  95.             outtext("It is my turn, with ");  outint(heap_size, 0);
  96.             outtext(" matches in the heap.  I take ");
  97.             outint(my_move, 0); outimage;
  98.           end;
  99.         move := my_move;
  100.       end of move;
  101.  
  102.     Boolean gagged;
  103.     procedure ungag; gagged := false;
  104.     procedure gag;     gagged := true;
  105.  
  106.   ! Initialization:   ;
  107.     gagged := false;
  108.  
  109.   end of Machine;
  110.  
  111.  
  112. Machine class Learning_machine;
  113.     protected beads, history, seed;
  114.   begin
  115.  
  116.     integer array beads(1 : initial_heap_size,  1 : max_matches_in_move),
  117.               history(1 : initial_heap_size);
  118.  
  119.     integer seed;
  120.  
  121.     integer procedure compute_move(heap_size);  integer heap_size;
  122.       begin integer move, max_move,  sum_beads, random_bead;
  123.         max_move := min(heap_size, max_matches_in_move);
  124.         for move := 1 step 1 until max_move do
  125.           sum_beads := sum_beads + beads(heap_size, move);
  126.         if sum_beads = 0 then
  127.           move := randint(1, max_move, seed)
  128.         else begin
  129.           random_bead := randint(1, sum_beads, seed);
  130.           move := 1; sum_beads := beads(heap_size, 1);
  131.           while sum_beads < random_bead do
  132.             begin
  133.               move      := move + 1;
  134.               sum_beads := sum_beads  + beads(heap_size, move);
  135.             end;
  136.         end;
  137.         history(heap_size) := move;
  138.         compute_move       := move;
  139.       end of compute_move;
  140.  
  141.     procedure Game_over(victory); Boolean victory;
  142.       begin integer heap_size;
  143.         for heap_size := 1 step 1 until  initial_heap_size do
  144.           if history(heap_size) > 0 then
  145.             begin
  146.               beads(heap_size, history(heap_size))
  147.                    := max(0, beads(heap_size, history(heap_size))
  148.                                + (if victory then 1  else -1));
  149.               history(heap_size) := 0;
  150.             end;
  151.       end of Game_over;
  152.  
  153.   !   Initialization:  ;
  154.       begin integer heap_size, move;
  155.         for heap_size := 1 step 1 until  initial_heap_size do
  156.           for move := 1 step 1 until  min(heap_size, max_matches_in_move) do
  157.             beads(heap_size, move) := 4;
  158.         seed := 1234179;
  159.       end of Initialization;
  160.  
  161.   end of Learning_machine;
  162.  
  163.  
  164. Learning_machine class Automatic_learner;
  165.     protected Automatic_training, Write_odds;
  166.   begin
  167.  
  168.     procedure Automatic_training;
  169.       begin
  170.         integer round_number; Boolean more_training;
  171.         ref(Learning_machine) sparring_partner;
  172.         sparring_partner
  173.             :- new Learning_machine(initial_heap_size,  max_matches_in_move);
  174.         User_message("Start of training against a  sparring partner");
  175.         gag; sparring_partner.gag;
  176.             ! This is to ensure that no moves are written  during training;
  177.         round_number := 1; more_training := true;
  178.         while more_training do
  179.           begin
  180.             Series_of_games(this Nim_player, sparring_partner,
  181.                         100, initial_heap_size);
  182.               !  The procedure Series_of_games  is  declared below;
  183.             outimage; outtext("Odds after ");  outint(round_number*100, 0);
  184.             outtext(" training games:"); outimage;
  185.             Write_odds;
  186.             round_number  := round_number + 1;
  187.             more_training   := not prompt_for_bool("Stop  training now? ");
  188.           end;
  189.         ungag; ! The training is over, and moves should be written henceforth;
  190.       end of Automatic_training;
  191.  
  192.     procedure Write_odds;
  193.       begin integer heap_size, move_number;
  194.         for heap_size := 1 step 1 until  initial_heap_size do
  195.           begin
  196.             outint(heap_size, 4); outtext(": ");
  197.             for move_number := 1 step 1 until
  198.                       min(heap_size, max_matches_in_move)
  199.               do outint(beads(heap_size, move_number), 5);
  200.             outimage;
  201.           end;
  202.       end of Write_odds;
  203.  
  204.   !   Initialization:  ;
  205.  
  206.     Automatic_training;
  207.  
  208.   end of Automatic_learner;
  209.  
  210.  
  211. procedure One_game(player_1, player_2, heap_size, player_1_first);
  212.     ref(Nim_player) player_1, player_2;  
  213.     integer heap_size; Boolean player_1_first;
  214.       !  Conducts a single game between player_1  and player_2
  215.       !  Lets player_1  start if player_1_first   is true;
  216.   begin
  217.     Boolean player_1_to_move;
  218.     player_1_to_move := player_1_first;
  219.     while heap_size > 0 do
  220.       begin
  221.         heap_size := heap_size - (if player_1_to_move
  222.                                then player_1 . move(heap_size)
  223.                                   else player_2 . move(heap_size));
  224.         player_1_to_move := not player_1_to_move;
  225.       end;
  226.     player_1 . Game_over(player_1_to_move);
  227.     player_2 . Game_over(not player_1_to_move);
  228.   end;
  229.  
  230. procedure Tournament(player_1, player_2, heap_size);
  231.     ref(Nim_player) player_1, player_2;  integer heap_size;
  232.   begin Boolean player_1_first;
  233.     player_1_first := true;  ! player_1  moves first in the first game;
  234.     while player_1 . another_game and then  player_2 . another_game do
  235.       begin
  236.         One_game(player_1, player_2, heap_size, player_1_first);
  237.       !  Alternate who moves first:   ;
  238.         player_1_first := not player_1_first;
  239.       end;
  240.   end of Tournament;
  241.  
  242. procedure Series_of_games(player_1, player_2,  number_of_games, heap_size);
  243.     ref(Nim_player) player_1, player_2;
  244.     integer number_of_games, heap_size;
  245.   begin
  246.     integer game_number; Boolean player_1_first;
  247.     player_1_first := true;
  248.     for game_number := 1 step 1 until  number_of_games do
  249.       begin
  250.         One_game(player_1, player_2, heap_size, player_1_first);
  251.         player_1_first := not player_1_first;
  252.       end;
  253.   end of Series_of_games;
  254.  
  255.  
  256. Boolean procedure prompt_for_bool(prompt); text prompt;
  257.   begin character c;
  258.     outtext(prompt); breakoutimage; inimage;
  259.     c := inchar;
  260.     prompt_for_bool := c = 'y' or c = 'Y';
  261.   end;
  262.  
  263. integer procedure prompt_for_int(prompt); text prompt;
  264.   begin
  265.     outtext(prompt); breakoutimage; inimage;
  266.     prompt_for_int := inint;
  267.   end;
  268.  
  269. character procedure prompt_for_char(prompt); text prompt;
  270.   begin
  271.     outtext(prompt); breakoutimage; inimage;
  272.     prompt_for_char := inchar;
  273.   end;
  274.  
  275. procedure User_message(message); text message;
  276.   begin outtext(message); outimage end;
  277.  
  278.  
  279. Tournament(new Human(15, 5), new Automatic_learner(15, 5), 15);
  280.  
  281.  
  282. end
  283.